00100	TITLE BIGNUM ARITHMETIC
00200	
00300	;AC DEFINITIONS
00400	NIL=0
00500	A=1
00600	B=2
00700	C=3
00800	T=6
00900	TT=7
01000	T10=10
01100	FF=16
01200	AR1=4
01300	F=15
01400	P=14
01500	D=12
01600	S=11
01700	AR2A=5
01800	R=13
01900	SP=17
02000	
02100	INUMIN=377777
02200	INUM0=577777
02300	SIGN=400000
02400	MINSGN==10
02500	
02600	INTERNAL BIGINI
02650	INTERNAL .COPY,.Q1,MAKBIG,POPAJ	;SOLELY FOR GFPAK* <A.HEARN>
02700	
02800	EXTERNAL CONS,FWCONS,ACONS,NCONS,XCONS,VBASE,VNOPOINT,LAST,NUMVAL
02900	EXTERNAL POSNUM,NEGNUM,NUM1,CTY,EVBIG,REVERSE,BPR
03000	EXTERNAL TRUE,FALSE,NUMV2,FIXNUM,FLONUM,FIX1A,LENGTH,MINUSP
03100	EXTERNAL BPR,NUM3,EVBIG,NUMV4,OPOV,NUMV3,NUMBP2,FIX2,OPR,FLOOV
03200	PAGE
03300	;POWER OF TEN
03400	PWR10:	MOVEM B,BASEX#
03500		MOVE C,B
03600		IMUL B,B	;BASE↑2
03700		IMUL B,B	;BASE↑4
03800		IMUL B,C	;BASE↑5
03900		IMUL B,B	;BASE↑TEN
04000		MOVEM B,BASE10#
04100		POPJ P,
04200	
04300	B0CONS:	MOVEI A,0
04400	BNCONS:	MOVEI B,0
04500	BCONS:	PUSHJ P,FWCONS
04600		JRST CONS
04700	
04800	QCONS=ACONS-1
04900	PAGE
05000	;INITIALIZE THE BIGNUM SYSTEM BY CHANGING MAGIC LOCATIONS IN LISP
05100	BIGINI:	MOVE A,[JRST BPRINT]
05200		MOVEM A,BPR		;PRINT
05300		HRRI A,BIGEV	
05400		MOVEM A,EVBIG		;EVAL
05500		HRRI A,NUMVB
05600		MOVEM A,NUMV4		;NUMVAL
05700		HRRI A,BIGDIS	
05800		MOVEM A,NUMV3		;BIGNUM OPS
05900		HRRI A,BIGNP
06000		MOVEM A,NUMBP2		;NUMBERP
06100		HRRI A,RDBNM
06200		HRRM A,NUM3		;READ
06300		HRRI A,FIXOVL
06400		HRRM A,OPOV		;OVERFLOW
06500		HRRI A,BFIX
06600		HRRM A,FIX2		;FIX
06700		JRST FALSE
06800	PAGE
06900	;BIGNUM PRINT
07000	;BPR IN LISP IS JRST BPRINT
07100	BPRINT:	CAIN B,POSNUM
07200		JRST BPRIN2
07300		CAIE B,NEGNUM
07400		JRST BPR+1
07500		XCT "-",CTY
07600	BPRIN2:	PUSHJ P,COPY
07700		PUSHJ P,BPRI
07800		POPJ P,
07900	
08000	BPRI:	MOVE B,VBASE
08100		SUBI B,INUM0
08200		PUSHJ P,PWR10
08300		PUSHJ P,BPRJ
08400		SKIPE A,VNOPOINT
08500		POPJ P,
08600		MOVE A,BASEX
08700		CAIE A,12
08800		POPJ P,
08900		MOVEI A,"."
09000		JRST (R)	;PARTICULAR TYO
09100	
09200	BPRJ:	MOVE B,BASE10
09300		PUSHJ P,Q1
09400		JUMPE B,BPR2	;ZERO QUOTIENT
09500		PUSH P,A	;REMAINDER
09600		MOVE A,B	;QUOTIENT
09700		PUSHJ P,BPRJ
09800		POP P,A		;REMAINDER
09900	
10000	BPR1:	MOVEI C,12	;PRINT TEN DIGITS
10100		SOJL C,CPOPJ
10200		IDIV A,BASEX
10300		HRLM B,(P)
10400		PUSHJ P,BPR1+1
10500		JRST FP7A1	;PARTICULAR TYO FOR DIGIT
10600	
10700	;IGNORE LEADING ZERO DIGITS FOR FIRST WORD
10800	BPR2:	JUMPE A,CPOPJ
10900		IDIV A,BASEX
11000		HRLM B,(P)
11100		PUSHJ P,BPR2
11200	FP7A1:	HLRE A,(P)
11300		ADDI A,"0"
11400		JRST (R)	;PARTICULAR TYO FOR DIGIT
11500	
11600	PAGE
11700	;DIVIDES BIGNUM IN A BY INTEGER IN B
11800	;DESTROYS ORIGINAL BIGNUM
11900	;RETURNS REMAINDER IN A, QUOTIENT IN B
11950	.Q1:
12000	Q1:	MOVEM B,Y#
12100		PUSH P,A
12200		HRRZ A,(A)
12300		JUMPE A,Q1A
12400		PUSHJ P,Q1+1
12500		POP P,C
12600		HRRM B,(C)
12700		HLRZ T,(C)
12800		MOVE B,(T)
12900		DIV A,Y
13000	Q1B:	MOVEM A,(T)	;REPLACE OLD DIGIT
13100		MOVE A,B
13200		MOVE B,C
13300		POPJ P,
13400	
13500	Q1A:	POP P,C
13600		HLRZ T,(C)
13700		MOVE A,(T)
13800		IDIV A,Y
13900		JUMPN A,Q1B	;NON-ZERO QUOTIENT - KEEP IT
14000		HRRZM FF,(T)	;RECLAIM FULL WORD
14100		MOVE FF,T
14200		HRRZM F,(C)	;RECLAIM FREE WORD
14300		HRRZ F,C
14400		MOVEI C,0
14500		JRST Q1B+1
14600	PAGE
14700	;BIGNUM READ
14800	;NUM3 IN LISP HAS JFCL 10,RDBNM
14900	RDBNM:	PUSH P,[NIL]	;INITIAL VALUE OF BIGNUM
15000		MOVSI C,700
15100		HRRI C,(SP)	;BYPE POINTER TO SPEC PDL
15200		MOVEM T,TSAV#
15300		MOVEM C,RDPTR#
15400		HRRZ B,NUM1	;BASE OF NUMBER
15500		PUSHJ P,PWR10
15600	
15700	RDNM1:	MOVEI C,12	;TEN DIGITS AT A TIME
15800		MOVEI A,0
15900		ILDB B,RDPTR
16000		JUMPE B,RDNM2	;END OF BIGNUM
16100		IMUL A,BASEX
16200		ADDI A,-"0"(B)
16300		SOJG C,.-4
16400		MOVE B,BASE10
16500		PUSHJ P,RDSUB
16600		JRST RDNM1
16700	
16800	RDNM2:	CAIN C,12	;NO DIGITS IN LAST SUPERDIGIT
16900		JRST RDNM3
17000		HRREI C,-12(C)	;NUMBER OF DIGITS IN LAST
17100		MOVEI B,1
17200		IMUL B,BASEX
17300		AOJL C,.-1	;COMPUTE BASEX↑(NUMBER OF DIGITS)
17400		PUSHJ P,RDSUB
17500	RDNM3:	MOVEI B,POSNUM
17600		MOVE T,TSAV
17700		TLNE T,MINSGN	;SIGN OF BIGNUM
17800		MOVEI B,NEGNUM
17900		POP P,A
18000		SUB P,[XWD 1,1]
18100		JRST QCONS
18200	
18300	RDSUB:	MOVE C,-1(P)
18400		PUSHJ P,BTIME1	;BIGNUM(C)*INT(B)+INT(A)
18500		MOVEM A,-1(P)
18600		POPJ P,
18700	PAGE
18800	BTIME0:	PUSH P,B
18900		PUSHJ P,COPY
19000		MOVE C,A
19100		POP P,B
19200		MOVEI A,0
19300	
19400	;BIG(C)*INT(B)+INT(A) 
19500	BTIME1:	JUMPE C,BNCONS	;END OF BIGNUM
19600		MOVEM B,MULR#	;MULTIPLIER
19700		PUSH P,C	;BIGNUM
19800	BT1B:	MOVEM A,CARRY#
19900		MOVS T,(C)
20000		MOVE A,(T)
20100		MUL A,MULR
20200		ADD B,CARRY
20300		TLZE B,SIGN
20400		ADDI A,1
20500	BT1E:	MOVEM B,(T)	;STORE LOW ORDER PRODUCT+CARRY IN BIGNUM
20600		HLRZS T		;(CDR BIGNUM)
20700		JUMPE T,BT1C	;END OF BIGNUM
20800		MOVE C,T
20900		JRST BT1B
21000	
21100	BT1C:	JUMPE A,POPAJ	;NO HIGH ORDER PART 
21200		PUSHJ P,BNCONS	;CONSES FOR REMAINING HIGH ORDER PART
21300		HRRM A,(C)	;RPLACD END OF BIGNUM
21400	POPAJ:	POP P,A
21500	CPOPJ:	POPJ P,
21600	PAGE
21700	;BIGNUM COPY
21750	.COPY:
21800	COPY:	JUMPE A,CPOPJ
21900		HLRZ B,(A)
22000		PUSH P,(B)
22100		HRRZ A,(A)
22200		PUSHJ P,COPY
22300		MOVE B,A
22400		POP P,A
22500		JRST BCONS
22600	
22700	
22800	;BIGNUM RECLAIM
22900	RECLAIM:	
23000		CAILE A,INUMIN
23100		POPJ P,
23200		EXCH A,F
23300		EXCH A,(F)
23400		HRRZS A
23500		EXCH A,F
23600		EXCH A,(F)
23700		HLRZ B,A	;TYPE
23800		HRRZS A
23900		CAIE B,POSNUM
24000		CAIN B,NEGNUM
24100		JRST UNCONS
24200		POPJ P,
24300	
24400	;BIGNUM UNCONS
24500	UNCONS:
24600		JUMPE A,CPOPJ
24700		HLRZ B,(A)
24800		MOVEM FF,(B)
24900		MOVE FF,B
25000		EXCH A,F
25100		EXCH A,(F)
25200		HRRZS A
25300		JRST UNCONS
25400	
25500	;EVBIG IN LISP HAS JRST BIGEV
25600	BIGEV:	CAIE TT,POSNUM
25700		CAIN TT,NEGNUM
25800		POPJ P,
25900		HRRZ AR1,(AR1)
26000		JRST EVBIG+1
26100	PAGE
26200	;BIGNUM MINUSP
26300	MINSP2:	CAIN B,POSNUM
26400		JRST FALSE
26500		JRST TRUE
26600	
26700	;BIGNUM MINUS
26800	MINS2:	CAIN B,POSNUM
26900		SKIPA B,[NEGNUM]
27000	ABS2:	MOVEI B,POSNUM	;BIGNUM ABS
27100		JRST QCONS
27200	
27300	;COMPARE TWO BIGNUMS A<B
27400	BCMPR:	PUSHJ P,BDIF
27500		PUSH P,A
27600		PUSHJ P,MINUSP
27700		EXCH A,(P)
27800		PUSHJ P,RECLAIM
27900		JRST POPAJ
28000	
28100	BEQUAL:	PUSHJ P,BDIF
28200		POP P,C
28300		CAIN A,INUM0
28400		JRST TRUE
28500		MOVE P,C
28600		PUSHJ P,RECLAIM
28700		JRST FALSE
28800	PAGE
28900	;DIFFERENCE OF TWO BIGNUMS
29000	BDIF:	PUSHJ P,COMPSN	;COMPLEMENT SIGN OF BIGNUM IN B
29100	;SUM OF TWO BIGNUMS
29200	;BIGNUMS IN A AND B; SIGN(A) IN T, SIGN(B) IN TT
29300	BPLUS:	PUSH P,B
29400		PUSHJ P,COPY
29500		EXCH A,(P)
29600		PUSHJ P,COPY
29700		POP P,C
29800		MOVE B,A
29900		MOVEI A,0
30000		CAME T,TT
30100		JRST BDIF1	;SIGNS DIFFERENT
30200		PUSH P,T	;SIGN OF RESULT
30300		PUSHJ P,BADD
30400		POP P,B
30500		JRST QCONS
30600	
30700	BDIF1:	CAIN TT,POSNUM
30800		EXCH B,C
30900		PUSHJ P,BSUB	;POSNUM IN C, NEGNUM IN B
31000		JUMPL B,BDIF3
31100		PUSHJ P,SUPRSS
31200		MOVEI B,POSNUM
31300		JRST MAKBIG
31400	
31500	BDIF3:	PUSHJ P,COMPLM
31600		MOVEI B,NEGNUM
31700		JRST MAKBIG
31800	
31900	BSUB:	MOVNI TT,1
32000		MOVSI T,(SUB TT,(B))
32100		JRST BAS
32200	
32300	BADD:	MOVEI TT,1
32400		MOVSI T,(ADD TT,(B))
32500	PAGE
32600	;CRY(A)(+ OR -) BIG(B) + BIG(C) → A, SIGN → B.
32700	;DESTROYS BOTH BIGNUMS
32800	
32900	BAS:	HRRM TT,BCRY
33000		PUSH P,B
33100	BP2A:	HRRM B,BTMP
33200		MOVS B,(B)
33300		HLRZ TT,(C)
33400		EXCH TT,FF
33500		EXCH TT,(FF)	;RECLAIM FULL WORD
33600		EXCH C,F
33700		EXCH C,(F)	;RECLAIM FREE WORD
33800		ADD TT,A
33900		XCT T		;BIG(C) (+ OR -) BIG (B)
34000		MOVEI A,0
34100		TLZE TT,SIGN	;TURN OFF HIGH BIT
34200	BCRY:	HRREI A,.	;SET CARRY IF OVERFLOW OR NEGATIVE
34300	BP2B:	MOVEM TT,(B)
34400		HLRZS B
34500		HRRZS C
34600		JUMPE B,BP2F	;END OF B
34700		JUMPN C,BP2A
34800		JRST BP2D	;FINISH WITH CARRY (+ OR -) BIG(B)
34900	
35000	BP2F:	JUMPE C,BP2H	;END OF C ALSO
35100		EXCH B,C
35200		HRRM B,@BTMP	;RPLACD END OF BIG(B) WITH REST OF C
35300		MOVSI T,(ADD TT,(B))	;FINISH WITH BIG(C) + CARRY
35400	BP2D:	HRRM B,BTMP
35500		MOVS B,(B)
35600		MOVE TT,A
35700		XCT T		;CARRY (+ OR -) INTEGER
35800		JUMPL TT,BP2K
35900		MOVEM TT,(B)
36000		CAME T,[SUB TT,(B)]
36100		JRST POSXIT	;CAN QUIT NOW
36200		MOVEI A,0	;TURN OFF CARRY
36300		JRST BP2L	;CONTINUE TO NEGATE
36400	
36500	BP2K:	HRRE A,BCRY
36600		TLZ TT,SIGN	;MAKE HIGH BIT ZERO
36700		MOVEM TT,(B)
36800	BP2L:	HLRZS B
36900		JUMPN B,BP2D
37000	BP2H:	JUMPLE A,XIT	;NO CARRY
37100		PUSHJ P,BNCONS
37200	BTMP:	HRRM A,.	;RPLACD END OF BIGNUM WITH CARRY
37300	POSXIT:	MOVEI B,0	;SIGN POSITIVE
37400		JRST POPAJ
37500	
37600	XIT:	MOVE B,A	;SIGN IN B
37700		JRST POPAJ
37800	PAGE
37900	;SUPPRESS LEADING ZEROS FROM BIGNUM
38000	SUPRSS:	SKIPA C,[JRST COMPL7]
38100	;COMPLEMENT BIGNUM  (2↑35 COMPLEMENT)
38200	COMPLM:	MOVSI C,(SUBM T,(B))
38300		JUMPE A,CPOPJ
38400		PUSH P,A
38500		HRLZI T,SIGN
38600		MOVEI TT,0
38700	COMPL4:	MOVS B,(A)
38800		SKIPN (B)
38900		JUMPE TT,COMPL3
39000		XCT C
39100		HRLOI T,SIGN-1
39200	COMPL7:	SKIPE (B)
39300		MOVEM A,TT
39400	COMPL3:	HLRZ A,B
39500		JUMPN A,COMPL4	;CONTINUE
39600		JUMPE TT,COMPL5	;ALL ZEROS
39700		HRRZ A,(TT)
39800		HLLZS (TT)	;RPLACD HIGH ORDER NON-ZERO WITH NIL
39900	COMPL6:	PUSHJ P,UNCONS	;UNCONS LEADING ZEROS
40000		JRST POPAJ
40100	
40200	COMPL5:	EXCH A,(P)
40300		JRST COMPL6
40400	
40500	;SIGN(TT)⊗SIGN(T) → TT
40600	MQSIGN:	CAIN T,POSNUM
40700		JRST CPOPJ
40800	;-SIGN(TT) → TT
40900	COMPSN:	CAIN TT,POSNUM
41000		SKIPA TT,[NEGNUM]
41100		MOVEI TT,POSNUM
41200		POPJ P,
41300	PAGE
41400	;BIGNUM MULTIPLY
41500	;BIG (A) * BIG (B) → A, SIGNS IN T,TT
41600	BTIMES:	PUSHJ P,MQSIGN
41700		PUSH P,TT	;SAVE SIGN OF RESULT
41800		PUSHJ P,BMUL
41900		POP P,B
42000		JRST MAKBIG
42100	
42200	;0(P) IS PARTIAL RESULT
42300	;-1(P) IS REMAINING REVERSED MULTIPLIER
42400	;-2(P) IS MULTIPLICAND
42500	
42600	BMUL:	PUSH P,B
42700		PUSHJ P,REVERSE
42800		PUSH P,A
42900		MOVEI A,0
43000		PUSH P,A
43100	BTLOOP:	SKIPN C,-1(P)
43200		JRST BTEND	;END OF MULTIPLIER
43300		JUMPE A,BTLP2	;FIRST TIME
43400		MOVE B,A
43500		PUSHJ P,FWCONS-1
43600		PUSHJ P,CONS	;INCREASE LENGTH OF PRODUCT
43700	BTLP2:	MOVEM A,(P)
43800		MOVE A,-2(P)
43900		PUSHJ P,COPY
44000		MOVS B,(C)	;NEXT MULTIPLIER DIGIT
44100		MOVE C,A
44200		HLRZM B,-1(P)
44300		MOVE B,(B)
44400		MOVEI A,0
44500		PUSHJ P,BTIME1
44600		MOVE C,(P)
44700		JUMPE C,BTLOOP	;NO ADD NEEDED ON FIRST TIME
44800		MOVE B,A
44900		MOVEI A,0
45000		PUSHJ P,BADD
45100		JRST BTLOOP
45200	
45300	BTEND:	SUB P,[XWD 3,3]
45400		JRST SUPRSS
45500	
45600	PAGE
45700	;EXTENSIONS OF INTERPRETER ROUTINES AND TESTS
45800	
45900	;ADDITION TO NUMVAL. NUMV4 IN LISP CHANGED TO JRST NUMVB
46000	NUMVB:	CAIE B,POSNUM
46100		CAIN B,NEGNUM
46200		JRST NUMVD2
46300		MOVE A,AR1
46400		JRST NUMV2	;PRINT ERROR MESSAGE
46500	
46600	NUMVD2:	POP P,C		;ADDRESS OF (PUSHJ P,NUMVAL) +1
46700		HLRZ C,(C)
46800		CAIN C,(JUMPN A,)	;ZEROP
46900		JRST FALSE
47000		CAIN C,(JUMPGE A,)	;MINUSP
47100		JRST MINSP2
47200		CAIN C,(MOVNS)		;MINUS
47300		JRST MINS2
47400		CAIN C,(MOVMS)		;ABS
47500		JRST ABS2
47600		CAIN C,(CAIE B,)	;FIX
47700		JRST POPAJ
47800		POPJ	P,		;**************** WAS A HALT  <A.HEARN>
47900	;EXTENSION TO NUMBERP.  NUMBRP4 IN LISP CHANGED TO JRST BIGNP
48000	BIGNP:	CAIE A,POSNUM
48100		CAIN A,NEGNUM
48200		JRST TRUE
48300		JRST FALSE
48400	PAGE
48500	;EXTENSION TO OP.  OPOV IN LISP CHANGED TO JFCL 10,FIXOVL
48600	FIXOVL:	HLRZ C,(C)
48700		CAIN C,(IMUL A,)
48800		JRST REMUL	;TIMES OVERFLOWED. RECOMPUTE
48810		JUMPE A,[SETZ B,
48820			 SETO TT,	;NEGATIVE
48830			 MOVEI A,Z
48840			 JRST FIXOVZ]
48900		TLC A,SIGN	;ALL OTHER CASES JUST OVERFLOWED 1 BIT
49000		MOVM B,A
49100		MOVE TT,A
49200		MOVEI A,1
49300	 FIXOVZ:	PUSHJ P,MKBG
49400		JRST QCONS
49500	
49600	REMUL:	MOVE A,AR1
49700		MOVEI B,FIXNUM
49800		MOVEI T,FIXNUM
49900		PUSHJ P,BIGTST
50000		JRST BTIMES	;USE THE BIGNUM MULTIPLICATION
50100	
50200	;EXTENSION TO OP.  NUMV3 CHANGED TO JRST BIGDIS
50300	;BIGDIS DETERMINES THE BIGNUM OPERATION TO BE PERFORMED
50400	BIGDIS:	CAIE T,FLONUM
50500		CAIN B,FLONUM
50600		JRST FLOBIG	;OPERATION WITH FLT PT OPERAND
50700		PUSHJ P,BIGTST	
50800		HLRZ C,(C)
50900		CAIN C,(ADD A,)	;PLUS
51000		JRST BPLUS
51100		CAIN C,(SUB A,)	;DIF
51200		JRST BDIF
51300		CAIN C,(IMUL A,)	;TIMES
51400		JRST BTIMES
51500		CAIN C,(IDIV A,)	;QUOTIENT
51600		JRST BQUO
51700		CAIN C,(JRST)		;LESSP OR GREATERP
51800		JRST BCMPR
51900		CAIN C,(JUMPN 0,)	;DIVIDE
52000		JRST BDIV
52100		CAIN C,(JUMPA)		;GCD
52200		JRST GCD
52300		CAIN C,(JUMPL)		;EQUAL
52400		JRST BEQUAL
52500		HALT			;TEMPROARY
52600	PAGE
52700	;TRANSFORMS GENERAL NUMBERS IN (A,T),(TT,B)
52800	;INTO BIGNUMS IN (A,T),(B,TT), VALUES IN A,B; SIGNS IN T,TT.
52900	BIGTST:	EXCH B,T	;FUNNY AC USAGE IN LISP
53000		PUSH P,T
53100		PUSH P,TT
53200		PUSHJ P,BIGSUB	;CONVERT NUMBER ORIGINALLY IN A,T
53300		EXCH B,-1(P)
53400		EXCH A,(P)
53500		PUSHJ P,BIGSUB	;CONVERT NUMBER ORIGINALLY IN TT,B
53600		MOVE TT,B
53700		MOVE B,A
53800		POP P,A
53900		POP P,T
54000		POPJ P,
54100	
54200	BIGSUB:	CAIE B,POSNUM
54300		CAIN B,NEGNUM
54400		POPJ P,		;NO CONVERSION NECESSARY
54500		CAIE B,FIXNUM
54600		JRST NUMV2	;CHECK FOR FLONUM
54700		MOVEI B,0
54800		MOVE TT,A	;GET VALUE OF NUMBER
54900		MOVM A,TT
55000		JUMPGE A,BIGSRT	
55100		MOVEI A,1	;BASTARD CASE OF -2↑35
55200	MKBG:	PUSHJ P,MKBIG
55300		JRST BIGSND
55400	
55500	BIGSRT:	PUSHJ P,BCONS
55600	BIGSND:	SKIPGE TT
55700		SKIPA B,[NEGNUM]
55800		MOVEI B,POSNUM
55900		POPJ P,
56000	
56100	MKBIG:	PUSH P,B
56200		PUSHJ P,BNCONS
56300		MOVE B,A
56400		POP P,A
56500		JRST BCONS
56600	PAGE
56700	;MAKE A LISP NUMBER FROM BIGNUM -- A IS LIST, B IS SIGN
56800	MAKBIG:	JUMPE A,FIX1A	;NULL LIST PRODUCES ZERO
56900		HRRZ C,(A)
57000		JUMPN C,QCONS		;A REAL BIGNUM
57100		HLRZ C,(A)		;ONLY ONE WORD OF PRECISION
57200		MOVE C,(C)
57300		CAIE B,POSNUM
57400		MOVNS C			;NEGATIVE 
57500		PUSHJ P,UNCONS
57600		MOVE A,C
57700		JRST FIX1A
57800	PAGE
57900	FLOBIG:	CAIE T,FLONUM
58000		JRST FLBG2
58100		MOVE A,(A)
58200		EXCH A,TT
58300		EXCH B,T
58400		PUSHJ P,BFLT
58500		EXCH A,TT
58600		JRST OPR
58700	
58800	FLBG2:	PUSHJ P,BFLT
58900		MOVE TT,(TT)
59000		JRST OPR
59100	
59200	;MAKE A FLOATING PT NUMBER OUT OF A BIGNUM
59300	BFLT:	PUSH P,C
59400		PUSH P,T
59500		CAIE T,POSNUM
59600		CAIN T,NEGNUM
59700		SKIPA T,[-200]
59800		JRST NUMV2
59900	BFLT2:	MOVE C,B
60000		HLRZ B,(A)
60100		HRRZ A,(A)
60200		ADDI T,43
60300		JUMPN A,BFLT2	;FIND LAST TWO WORDS OF BIGNUM
60400		MOVE B,(B)
60500		MOVE C,(C)
60600	BFLT3:	TLNE B,SIGN/2
60700		JRST BFLT4
60800		ASHC B,1
60900		SOJA T,BFLT3	;NORMALIZE B,C
61000	BFLT4:	JUMPGE T,FLOOV
61100		ASH B,-10
61200		DPB T,[POINT 8,B,8]
61300		MOVE A,B
61400		POP P,T
61500		POP P,C
61600		CAIE T,POSNUM
61700		MOVNS A
61800		POPJ P,
61900	
62000	;MAKE A BIGNUM FROM A FLT PT NUMBER
62100	BFIX:	MOVE A,(P)
62200		PUSHJ P,NUMVAL
62300		MOVMS A
62400		MULI A,400
62500		MOVEI C,-243(A)	;#LEFT SHIFTS NEEDED
62600		IDIVI C,43	;C←#EXTRA WORDS-1, D←#SHIFTS
62700		MOVEI A,0
62800		ASHC A,(C+1)
62900		PUSH P,B
63000		PUSHJ P,BNCONS
63100		MOVE B,A
63200		POP P,A
63300		PUSHJ P,BCONS
63400		SOJL C,BFIX2
63500		MOVE B,A
63600		MOVEI A,0
63700		PUSHJ P,BCONS
63800		SOJGE C,.-3
63900	BFIX2:	POP P,TT
64000		PUSHJ P,BIGSND
64100		JRST QCONS
64200	
64300	PAGE
64400	;BIGNUM DIVIDE
64500	BDIV:	PUSHJ P,MQSIGN	;COMPLEMENT SIGN OF TT IF T IS NEGNUM
64600		PUSH P,T	;SIGN OF REMAINDER
64700		PUSH P,TT	;SIGN OF QUOTIENT
64800		PUSHJ P,DIVSUB
64900	BDIV2:	EXCH B,(P)
65000		PUSHJ P,MAKBIG	;QUOTIENT
65100		MOVE B,-1(P)
65200		MOVEM A,-1(P)
65300		POP P,A
65400		PUSHJ P,MAKBIG	;REMAINDER
65500		POP P,B
65600		JRST XCONS
65700	
65800	BQUO:	PUSHJ P,MQSIGN
65900		PUSH P,TT
66000		PUSHJ P,DIVSUB
66100		PUSH P,A
66200		MOVE A,B
66300		PUSHJ P,UNCONS
66400		POP P,A
66500		POP P,B
66600		JRST MAKBIG
66700	
66800	DIVSUB:	HRRZ C,(B)
66900		JUMPN C,DIV1
67000	;NULL(CDR B) MEANS SINGLE LENGTH DIVISOR
67100	BQUO1:	PUSH P,B
67200		PUSHJ P,COPY
67300		POP P,B
67400		HLRZ B,(B)
67500		MOVE B,(B)
67600		PUSHJ P,Q1
67700		PUSH P,B	;QUOTIENT
67800		PUSHJ P,BNCONS
67900		MOVE B,A
68000		JRST POPAJ
68100	
68200	PAGE
68300	;DIV1 DOES LONG DIVISION OF X/Y 
68400	;ENTER WITH X IN A, Y IN B.
68500	DIV1:	PUSH P,A	;X
68600		PUSH P,B	;Y
68700		MOVE A,B
68800		PUSHJ P,HIDIG
68900		HRLOI A,SIGN/2-1
69000		IDIV A,(C)	;(BETA/2-1)/Y[N-1]+1
69100		ADDI A,1
69200		MOVEM A,SCALE#
69300		MOVE B,A
69400		MOVE A,(P)	;Y - DIVISOR
69500		PUSHJ P,BTIME0	;SCALE*Y
69600		MOVEM A,V	;SCALED DIVISOR
69700		MOVEM A,(P)	;PROTECT V FROM GC
69800		PUSHJ P,HIDIG
69900		POP C,VH	;V[N-1]
70000		POP C,VH1	;V[N-2]
70100		MOVE A,-1(P)	;X - NUMERATOR
70200		PUSHJ P,COPY
70300		PUSHJ P,EXTND
70400		MOVE B,SCALE
70500		MOVE C,A
70600		PUSHJ P,BTIME1-1	;SCALE*X  -- SCALED NUMERATOR
70700		MOVEM A,-1(P)	;U
70800		PUSH P,[NIL]	
70900		HRRZM P,QUO#	;POINTER TO QUOTIENT LIST
71000		PUSHJ P,LENGTH
71100		PUSH P,A
71200		MOVE A,V#
71300		PUSHJ P,LENGTH
71400		POP P,B
71500		SUB B,A		;LENGTH(U)-LENGTH(V)
71600		MOVE A,-2(P)	;U
71700		JUMPLE B,DIV1X	;SPECIAL CASE OF U<V
71800		PUSHJ P,DIV2	;CARRY OUT DIVISION WITH PARAMETERS
71900	DIV1X:	PUSHJ P,SUPRSS	;SUPPRESS LEADING ZEROS OF REMAINDER
72000		JUMPE A,DIV1Y	;ZERO REMAINDER
72100		MOVE B,SCALE
72200		PUSHJ P,Q1	;U/SCALE - FINAL REMAINDER IN B
72300		MOVE A,B
72400	DIV1Y:	EXCH A,(P)
72500		PUSHJ P,SUPRSS	;SUPPRESS LEADING ZEROS IN QUOTIENT
72600		POP P,B
72700		SUB P,[XWD 2,2]
72800		POPJ P,
72900	
73000	;RECURSIVE FUNCTION TO POSITION V PROPERLY WITH RESPECT TO U.
73100	; ON SUCCESSIVE CALLS TO DIV3 WHICH CALCULATES QUOTIENT DIGITS.
73200	;ENTER DIV2 WITH U IN A, N IN B. N= LENGTH(U)-LENGTH(V)-1.
73300	
73400	DIV2:	SOJLE B,DIV3
73500		PUSH P,A	;U
73600		HRRZ A,(A)
73700		PUSHJ P,DIV2
73800		HRRM A,@(P)	;(RPLACD U,(DIV3(CDR U)))
73900		POP P,A
74000		JRST DIV3
74100	PAGE
74200	;ENTER WITH U[J] IN A
74300	
74400	DIV3:	PUSH P,A	;UJ
74500		PUSHJ P,HIDIG
74600		POP C,A		;UH
74700		CAML A,VH#
74800		JRST DIVCS1	;STRANGE CASE WHEN UH≥VH
74900		POP C,B		;UH1
75000		DIV A,VH	;(UH*BETA+UH1)/VH
75100		PUSH P,A	;QUOTIENT DIGIT
75200	L1:	MOVEM B,REM#	;REMAINDER
75300		MUL A,VH1#
75400		SUB A,REM	;(VH1*QUO)-BETA*REM
75500		CAMGE B,(C)	;UH2
75600		SUBI A,1
75700		JUMPG A,DIVCS2	;QUOTIENT TOO BIG
75800	L4:	MOVE A,V
75900		MOVE B,(P)	;QUOTIENT DIGIT
76000		PUSHJ P,BTIME0	;Q*V
76100		MOVE C,-1(P)	;UJ
76200		MOVE B,A
76300		MOVEI A,0
76400		PUSHJ P,BSUB	;UJ-Q*V
76500		JUMPL B,DIVCS3	;QUOTIENT TOO BIG
76600	L3:	MOVEM A,-1(P)	;NEW UJ
76700		POP P,A		;QUOTIENT DIGIT
76800		MOVE B,@QUO
76900		PUSHJ P,BCONS
77000		MOVEM A,@QUO	;NEW QUOTIENT LIST
77100		MOVE A,(P)
77200		PUSHJ P,DIVSRT	;SHORTEN UJ BY ONE DIGIT
77300		JRST POPAJ
77400	PAGE
77500	;SPECIAL CASE OF UH≥VH
77600	DIVCS1:	HRLOI A,SIGN-1		;BETA-1
77700		PUSH P,A
77800		POP C,B		;UH1
77900		ADD B,VH	;R←UH1+VH
78000		JUMPL B,L4
78100		JRST L1
78200	
78300	;SPECIAL CASE CORRECTION FOR QUOTIENT
78400	DIVCS2:	SOS A,(P)		;QUOTIENT←QUOTIENT-1
78500		MOVE B,REM
78600		ADD B,VH	;R←R+VH
78700		JRST L1
78800	
78900	;SPECIAL CASE OF QUOTIENT TOO LARGE
79000	DIVCS3:	SOS (P)		;QUOTIENT←QUOTIENT-1
79100		PUSH P,A
79200		MOVE A,V
79300		PUSHJ P,COPY
79400		MOVE C,A
79500		POP P,B
79600		MOVEI A,0
79700		PUSHJ P,BADD	;U←U+V
79800		MOVEM A,-1(P)
79900		PUSHJ P,DIVSRT	;SHORTEN OVERFLOWED DIGIT
80000		JRST L3+1
80100	PAGE
80200	;PUSHES SUCCESSIVE DIGITS OF LIST IN A ONTO PDL
80300	;RETURNS C POINTING TO PDL LOCATION OF LAST DIGIT
80400	HIDIG:	MOVE C,P
80500		MOVS B,(A)
80600		PUSH P,(B)
80700		HLRZ A,B
80800		JUMPN A,HIDIG+1
80900		EXCH C,P
81000		POPJ P,
81100	
81200	;SHORTEN LIST BY ONE
81300	DIVSRT:	MOVE C,A
81400		HRRZ A,(A)
81500		HRRZ B,(A)	;CDDR
81600		JUMPN B,.-3
81700		HLLZS (C)	;NULL (CDDR C) => RPLACD(C NIL)
81800		HLRZ B,(A)
81900		JRST UNCONS
82000	
82100	;LENGTHEN LIST BY ONE
82200	EXTND:	PUSH P,A
82300		PUSHJ P,LAST
82400		MOVE T,A
82500		PUSHJ P,B0CONS
82600		HRRM A,(T)
82700		JRST POPAJ
82800	PAGE
82900	GA==4
83000	GB==5
83100	GC==6
83200	GD==7
83300	UP==10
83400	VP==11
83500	Q==12
83600	;BIGNUM GCD
83700	GCD:	PUSH P,B
83800		PUSHJ P,COPY
83900		EXCH A,(P)	;V
84000		PUSHJ P,COPY
84100		PUSH P,A	;U
84200		PUSHJ P,COPY
84300		MOVE C,A
84400		MOVE A,-1(P)	
84500		PUSHJ P,COPY
84600		MOVE B,A	;U
84700		MOVEI A,0
84800		PUSHJ P,BSUB	;V-U
84900		PUSH P,B
85000		PUSHJ P,BSUBND
85100		JUMPE A,GCDSC1	;U=V
85200		PUSHJ P,UNCONS
85300		POP P,B
85400		JUMPGE B,GCD2	;U≥V
85500		MOVE A,(P)
85600		EXCH A,-1(P)
85700		MOVEM A,(P)
85800	PAGE
85900	;NOW V<U   V IN -1(P), U IN (P)
86000	GCD2:	MOVE A,-1(P)
86100		JUMPE A,GCDEND	;V IS ZERO
86200		HRRZ B,(A)
86300		JUMPE B,GCDSING	;V IS SINGLE PRECISION
86400		PUSHJ P,LENGTH	;LENGTH (V)
86500		MOVE T,A
86600		MOVE A,(P)	;U
86700		PUSHJ P,LENGTH
86800		SUB A,T		;L(U)-L(V)
86900		JUMPE A,GCD4
87000		SOJN A,GCD7A	;>1
87100		MOVE A,-1(P)	;V
87200		PUSHJ P,EXTND	;LENGTHEN V BY ONE HIGH ORDER ZERO
87300	GCD4:	MOVE A,(P)	;U
87400		PUSHJ P,HIDIG
87500		HRLOI A,SIGN/2-1	;BETA/2-1
87600		IDIV A,(C)	;(BETA/2-1)/U[N-1]+1
87700		ADDI A,1
87800		MOVEM A,SCALE
87900		PUSHJ P,GCSB
88000		MOVE UP,A	;SCALE*UH
88100		MOVE A,-1(P)	;V
88200		PUSHJ P,HIDIG
88300		PUSHJ P,GCSB
88400		MOVE VP,A	;SCALE*VH
88500		MOVEI GA,1
88600		MOVEI GD,1
88700		SETZB GC,GB
88800	PAGE
88900	GCD5:	MOVE A,UP
89000		ADD A,GA
89100		MOVE B,VP
89200		ADD B,GC
89300		JUMPE B,GCD7
89400		JUMPL A,GCD5X	;OVERFLOW CASE
89500		IDIV A,B	;(U'+A)/(V'+C)
89600	GCD5A:	MOVE Q,A
89700		MOVE A,UP
89800		ADD A,GB
89900		MOVE B,VP
90000		ADD B,GD
90100		JUMPE B,GCD7
90200		SKIPG B
90300		TDZA A,A	;SPECIAL CASE OF V'+D = BETA
90400		IDIV A,B	;(U'+B)/(V'+D)
90500		CAME A,Q
90600		JRST GCD7
90700		MOVE A,GC
90800		EXCH GA,GC	;A'←C
90900		IMUL A,Q
91000		SUB GC,A	;C'←A-Q*C
91100		MOVE A,GD
91200		EXCH GB,GD	;B'←D
91300		IMUL A,Q	
91400		SUB GD,A	;D'←B-Q*D
91500		MOVE A,VP
91600		EXCH UP,VP	;UP'←VP
91700		IMUL A,Q
91800		SUB VP,A	;VP'←UP-Q*VP
91900		JRST GCD5
92000	PAGE
92100	;SPECIAL CASE WHEN U'+A=BETA
92200	GCD5X:	MOVEI A,1
92300		MOVE C,B
92400		MOVEI B,0
92500		DIV A,C
92600		JRST GCD5A
92700	
92800	GCD7:	JUMPE GB,GCD7A
92900		MOVE A,(P)	;U
93000		MOVE B,-1(P)	;V
93100		PUSH P,GC
93200		PUSH P,GD
93300		PUSHJ P,GCDSB	;A*U+B*V
93400		POP P,GB
93500		POP P,GA
93600		EXCH A,(P)	;U
93700		MOVE B,-1(P)
93800		PUSHJ P,GCDSB	;C*U+D*V
93900		MOVEM A,-1(P)	;V
94000		JRST GCD2
94100	
94200	GCDSB:	PUSH P,GA
94300		PUSH P,GB
94400		PUSH P,B
94500		MOVM B,GA
94600		PUSHJ P,BTIME0
94700		EXCH A,(P)	;B
94800		MOVM B,-1(P)	;GB
94900		PUSHJ P,BTIME0
95000		POP P,B	;A*GA
95100		POP P,GA
95200		POP P,GB
95300		XOR GA,GB
95400		MOVE C,A
95500		MOVEI A,0
95600		JUMPGE GA,BADD	;SIGNS SAME
95700		PUSHJ P,BSUB	;SIGNS DIFFERENT
95800	BSUBND:	JUMPGE B,SUPRSS
95900		JRST COMPLM
96000	
96100	GCD7A:	MOVE A,-1(P)
96200		PUSHJ P,SUPRSS
96300		MOVE B,A
96400		MOVE A,(P)
96500		PUSHJ P,DIV1	;U/V
96600		EXCH B,-1(P)	;V←REMAINDER
96700		MOVEM B,(P)	;U←V
96800		PUSHJ P,UNCONS	;DONT NEED QUOTIENT
96900		JRST GCD2
97000	PAGE
97100	GCDSING:	
97200		POP P,A	;U
97300		MOVE B,(P)	;V - SINGLE PRECISION
97400		HLRZ B,(B)
97500		MOVE B,(B)
97600		MOVEM B,(P)
97700		PUSHJ P,Q1	;U MOD V → A
97800		POP P,B		;A < B
97900		JUMPE A,GCDS2
98000	;SINGLE PRECISION GCD
98100		IDIV B,A
98200		MOVE B,A
98300		MOVE A,C
98400		JUMPN A,.-3
98500	GCDS2:	MOVE A,B
98600		JRST FIX1A
98700	
98800	GCSB:	MOVE A,-1(C)
98900		MUL A,SCALE
99000		MOVE B,A
99100		MOVE A,(C)
99200		IMUL A,SCALE
99300		ADD A,B
99400		POPJ P,
99500	PAGE
99600	GCDSC1:	SUB P,[XWD 2,2]
99700		POP P,A
99800		MOVEI B,POSNUM
99900		JRST MAKBIG
     

00100	
00200	GCDEND:	POP P,A	;U IS RESULT
00300		SUB P,[XWD 1,1]
00400		MOVEI B,POSNUM
00500		JRST MAKBIG
00600	
00700		END